home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / FROMUTS / PERL / Perl / Lib / Pwd < prev    next >
Text File  |  1991-02-09  |  1KB  |  53 lines

  1. ;# pwd.pl - keeps track of current working directory in PWD environment var
  2. ;#
  3. ;# $Header: pwd.pl,v 3.0.1.2 91/01/11 18:09:24 lwall Locked $
  4. ;#
  5. ;# $Log:    pwd.pl,v $
  6. ;# Revision 3.0.1.2  91/01/11  18:09:24  lwall
  7. ;# patch42: some .pl files were missing their trailing 1;
  8. ;# 
  9. ;# Revision 3.0.1.1  90/08/09  04:01:24  lwall
  10. ;# patch19: Initial revision
  11. ;# 
  12. ;#
  13. ;# Usage:
  14. ;#    require "pwd.pl";
  15. ;#    &initpwd;
  16. ;#    ...
  17. ;#    &chdir($newdir);
  18.  
  19. package pwd;
  20.  
  21. sub main'initpwd {
  22.     if ($ENV{'PWD'}) {
  23.     local($dd,$di) = stat('.');
  24.     local($pd,$pi) = stat($ENV{'PWD'});
  25.     return if $di == $pi && $dd == $pd;
  26.     }
  27.     chop($ENV{'PWD'} = `pwd`);
  28. }
  29.  
  30. sub main'chdir {
  31.     local($newdir) = shift;
  32.     if (chdir $newdir) {
  33.     if ($newdir =~ m#^/#) {
  34.         $ENV{'PWD'} = $newdir;
  35.     }
  36.     else {
  37.         local(@curdir) = split(m#/#,$ENV{'PWD'});
  38.         @curdir = '' unless @curdir;
  39.         foreach $component (split(m#/#, $newdir)) {
  40.         next if $component eq '.';
  41.         pop(@curdir),next if $component eq '..';
  42.         push(@curdir,$component);
  43.         }
  44.         $ENV{'PWD'} = join('/',@curdir) || '/';
  45.     }
  46.     }
  47.     else {
  48.     0;
  49.     }
  50. }
  51.  
  52. 1;
  53.